home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_pas / ootp_4 / budget.pas next >
Pascal/Delphi Source File  |  1990-04-16  |  7KB  |  229 lines
  1. program Budget1;
  2. uses ListObj, Crt;
  3.  
  4. type
  5.  
  6. String15 = string[15];
  7. String24 = string[24];
  8. var
  9.    ParentName : String15;
  10.    Root           : ListPtr;
  11.  
  12. type
  13.  
  14. BudgetPtr = ^BaseBudget;
  15. BudItemPtr = ^BudItem;
  16. BudCatPtr = ^BudCat;
  17.  
  18. BaseBudget = object( List )     { This object is the Trunk of the tree }
  19.             procedure Init;
  20.             procedure Report;
  21.             end;
  22.  
  23. BudCat = object( Node )  { This object is a Branch }
  24.          Category : String15;
  25.          Budgeted : real;
  26.          Actual   : real;
  27.          Items    : List;
  28.          Parent   : ListPtr;
  29.          constructor Init( CatName : String15; HowMuchBudgeted : real );
  30.          function GetActual : real;
  31.          function GetVariance : real;
  32.          procedure Report;
  33.          end;
  34.  
  35. BudItem = object( Node )  { Objects of this type are Leaves }
  36.           Category : String15;  { Name of the parent category }
  37.           ToWhom   : String24;
  38.           ForWhat  : String24;
  39.           HowMuch  : real;
  40.           procedure Init( CatName : String15;
  41.                           Who, What : String24;
  42.                           Amount : real );
  43.           procedure Show;
  44.           end;
  45.  
  46. {$F+}
  47. function FindBudCat( pNode : pointer ) : boolean;
  48. {$F-}
  49. var
  50.    pBudCat : ^BudCat;
  51. begin
  52.      pBudCat := pNode;
  53.      if pBudCat^.Category = ParentName then
  54.         FindBudCat := true
  55.      else
  56.         FindBudCat := false;
  57. end;
  58.  
  59. procedure BaseBudget.Init;
  60. begin
  61.      List.Init;
  62.      Root := @Self;
  63. end;
  64.  
  65. procedure BaseBudget.Report;
  66. var
  67.    pBudCat : BudCatPtr;
  68.    Spent : real;
  69.    Budgeted : real;
  70. begin
  71.      Spent := 0;
  72.      Budgeted := 0;
  73.      writeln;
  74.      writeln( 'BUDGET REPORT':40 );
  75.      if FindObject = true then { if there are members of BaseBudget }
  76.         repeat
  77.         pBudCat := GetCursor;
  78.         pBudCat^.Report;
  79.         Spent := Spent + pBudCat^.Actual;
  80.         Budgeted := Budgeted + pBudCat^.Budgeted;
  81.         until FindnextObject = false;
  82.      write( 'ALL CATEGORIES: Budgeted: $', Budgeted:4:2,
  83.             ' Spent: $', Spent:4:2 );
  84.      if Budgeted >= Spent then
  85.         write( ' UNDER budget by $', (Budgeted - Spent):4:2 )
  86.      else
  87.         write( ' OVER budget by $', (Spent - Budgeted ):4:2 );
  88. end;
  89.  
  90. procedure BudCat.Report;
  91. var
  92.    pBudItem : BudItemPtr;
  93.    Header : string;
  94. begin
  95.      Header := Category + '----------------------------------------' +
  96.                           '---------------------------------------';
  97.      writeln( Copy( Header, 1, 79 ));
  98.  
  99.      if Items.FindObject = true then
  100.         repeat
  101.         pBudItem := Items.GetCursor;
  102.         pBudItem^.Show;
  103.         until Items.FindNextObject = false;
  104.      writeln( 'Total spent in ', Category, ' budget category: $',
  105.               GetActual:4:2 );
  106.      if GetVariance > 0 then { over budget! }
  107.         writeln( 'You spent MORE than the budgeted $', Budgeted:4:2,
  108.                  ' by $', GetVariance:4:2 )
  109.      else
  110.         if GetVariance < 0 then { under budget !}
  111.            writeln( 'Hooray! You spent $', -GetVariance:4:2,
  112.                     ' LESS than the $', Budgeted:4:2,
  113.                     ' budgeted for this category.')
  114.         else
  115.            writeln( 'You''ve spent exactly the amount budgeted for the ',
  116.                     Category, ' category.' );
  117.      writeln;
  118. end;
  119.  
  120.  
  121. constructor BudCat.Init( CatName : String15; HowMuchBudgeted : real );
  122. var
  123.    code : integer;
  124.    SAns : string;
  125. begin
  126.      Node.Init( SizeOf( Self ) );
  127.      Items.Init;
  128.      Category := CatName;
  129.      if HowMuchBudgeted > 0 then
  130.         Budgeted := HowMuchBudgeted
  131.      else
  132.         repeat
  133.               write( ' How much to budget for the new category ''',
  134.                      CatName, '''? :' );
  135.               readln( SAns );
  136.               Val( SAns, Budgeted, code );
  137.         until code = 0;
  138.      Actual := -99.99;
  139.      Parent := Root;
  140.      AppendToList( Parent^ );
  141. end;
  142.  
  143. function BudCat.GetActual : real;
  144. var
  145.    pBudItem : BuditemPtr;
  146. begin
  147.      if Items.FindObject = true then
  148.         begin
  149.         Actual := 0.0;
  150.         repeat
  151.         pBudItem := Items.GetCursor;
  152.         Actual := Actual + pBudItem^.HowMuch;
  153.         until Items.FindNextObject = false;
  154.         end
  155.      else
  156.         Actual := -99.99;
  157.      GetActual := Actual;
  158. end;
  159.  
  160. function BudCat.GetVariance : real;
  161. begin
  162.      GetVariance := GetActual - Budgeted;
  163. end;
  164.  
  165. procedure BudItem.Show;
  166. begin
  167.      writeln( ToWhom:32, '| ', ForWhat:32, '| $', HowMuch:4:2 );
  168. end;
  169.  
  170. procedure BudItem.Init( CatName : String15;
  171.                           Who, What : String24;
  172.                           Amount : real );
  173. var
  174.    pToParent : BudCatPtr;
  175.    Tmp : ListDemonType;
  176. begin
  177.      Node.Init( SizeOf(Self) );
  178.      ToWhom := Who;
  179.      ForWhat := What;
  180.      Category := CatName;
  181.      HowMuch := Amount;
  182.      Tmp := Root^.FindObjectDemon;
  183.      Root^.FindObjectDemon := FindBudCat;
  184.      ParentName := Category;
  185.      if Root^.FindObject = true then
  186.         begin
  187.         pToParent := Root^.GetCursor;
  188.         AppendToList( pToParent^.Items );
  189.         end
  190.      else
  191.         begin
  192.         New( pToParent, Init( Category, -99.99 ) );
  193.         AppendToList( pToParent^.Items );
  194.         end;
  195.  
  196.      Root^.FindObjectDemon := Tmp;
  197.  
  198. end;
  199.  
  200. var
  201.    MyBudget : BaseBudget;
  202.    Utilities, Entertainment, CreditPayment : BudCat;
  203.    Expense : array[0..10] of BudItem;
  204. begin
  205.      ClrScr;
  206.      MyBudget.Init;
  207.      Utilities.Init( 'Utilities', 150.00 ); 
  208.      Entertainment.Init( 'Entertainment', 100.00 ); 
  209.      CreditPayment.Init( 'CreditPayment', 1000.00 ); 
  210.      { all of these individual items could just as easily be obtained
  211.        from a file!  }
  212.      Expense[0].Init( 'Utilities', 'Electric Co.', 'Electricity', 45.47 );
  213.      Expense[1].Init( 'Entertainment', 'Cinema 99', 'Movie', 12.50 );
  214.      Expense[2].Init( 'Utilities', 'Telco 2', 'Long distance', 56.12 );
  215.      Expense[3].Init( 'CreditPayment', 'AmEx', 'Travel expenses', 591.20 );
  216.      Expense[4].Init( 'CreditPayment', 'FirstBank', 'Car loan', 212.34 );
  217.      Expense[5].Init( 'Utilities', 'Telco 1', 'Phone service', 18.07 );
  218.      Expense[6].Init( 'Entertainment', 'Walton''s', 'SF books', 32.07 );
  219.      Expense[7].Init( 'Entertainment', 'Fish shop', 'Rental & Bait', 47.00 );
  220.      Expense[8].Init( 'CreditPayment', 'NextBank', 'Line of credit', 100.00 );
  221.      Expense[9].Init( 'Utilities', 'AAA Oil', 'Heating Oil', 37.09 );
  222.      Expense[10].Init( 'CreditPayment', 'LastBank', 'Computer', 96.46 );
  223.  
  224.      { Here's is the line that does all the work }
  225.      MyBudget.Report;
  226.  
  227.      repeat until KeyPressed;
  228. end.
  229.